home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xlib / poly < prev    next >
Encoding:
Text File  |  1991-08-05  |  977 b   |  36 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (require 'xlib)
  4.  
  5. (define (poly)
  6.   (let* ((dpy (open-display))
  7.      (black (black-pixel dpy)) (white (white-pixel dpy))
  8.      (width 400) (height 400)
  9.      (win (create-window 'parent (display-root-window dpy)
  10.                'width width 'height height
  11.                'background-pixel white 'event-mask '(exposure)))
  12.      (gc (create-gcontext 'window win 'function 'xor
  13.                         'background white 'foreground black))
  14.      (l '(#f #f #f))
  15.      (rand (lambda (x) (modulo (random) x))))
  16.     (map-window win)
  17.     (handle-events dpy #t #f
  18.       (else (lambda args
  19.           (set! width (window-width win))
  20.           (set! height (window-height win)) #t)))
  21.     (unwind-protect
  22.      (let loop ((n 0))
  23.        (if (= n 200)
  24.      (begin
  25.        (clear-window win)
  26.        (display-wait-output dpy #f)
  27.        (set! n 0)))
  28.        (fill-polygon win gc
  29.              (list->vector
  30.               (map (lambda (x) (cons (rand width) (rand height))) l))
  31.              #f 'convex)
  32.        (loop (1+ n)))
  33.     (close-display dpy))))
  34.           
  35. (poly)
  36.